home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / c_arr1a / c_array.cls next >
Text File  |  1999-09-19  |  9KB  |  284 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "c_Array"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  11. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  12. '**************************************
  13. '**************************************
  14. 'c_ARRAY VERSION 1
  15. '
  16. 'By: Jan Botha
  17. 'eMail: c03jabot@prg.wcape.school.za
  18. 'Using: Visual Basic 5
  19. 'Date: 18 September 1999
  20. '**************************************
  21. '**************************************
  22.  
  23. 'Introduction:
  24. '----------------------------------------------------
  25. 'I got the idea to program c_Array after I became
  26. 'aware of the fact that Collections are slow and
  27. 'use quite an amount of memory.
  28. 'This class only uses arrays to accomplish everything
  29. 'that a collection can do.
  30. '
  31. 'I have also added a few things:
  32. '
  33. '1. A MoveUp and MoveDown method to move an item
  34. '   up or down in the array
  35. '2. A Clear method to clear everything
  36. '3. I have added the possibility to use keys to
  37. '   identify an item
  38. '
  39. 'Thus, you can use most of the methods by specifying
  40. 'either a key or an index
  41. '
  42. 'Thank you for using c_Array 1. Please do email
  43. 'me on comments, suggestions and especially BUGS!
  44. 'Upgrades and improvements coming soon! See the Readme
  45. 'file for more information.
  46. '
  47. 'The Author
  48. '(-: Jan Botha :-)
  49. '-----------------------------------------------------
  50.  
  51. Option Explicit
  52.  
  53. Private Type m_Arrays
  54.     m_Key As String
  55.     m_Value As String
  56. End Type
  57.  
  58. Private m_Count As Integer 'this will contain the number of items
  59. Private m_Array() As m_Arrays 'Main Array
  60. Private mmm As Collection
  61.  
  62. Public Function Clear()
  63.     ReDim m_Array(0) As m_Arrays
  64.     m_Count = 0
  65. End Function
  66.  
  67. Public Function Count() As Integer
  68.     m_Count = UBound(m_Array)
  69.     Count = m_Count
  70. End Function
  71.  
  72. Public Function Remove(Optional ByVal Index As Integer, Optional ByVal Key As String)
  73.     Dim counter As Integer
  74.     
  75.     'if the key and the index is invalid -> exit function
  76.     If Key = "" And Not Between(Index, 0, m_Count + 1) Then Exit Function
  77.     
  78.     'if the index is invalid, remove item using key
  79.     If Not Between(Index, 0, m_Count + 1) Then
  80.         For counter = 1 To m_Count
  81.             If m_Array(counter).m_Key = Key Then
  82.                 RemoveIt counter
  83.                 Exit Function
  84.             End If
  85.         Next
  86.       'else if the index is valid
  87.       Else
  88.         RemoveIt Index
  89.     End If
  90.     
  91. End Function
  92.  
  93. Public Function Add(ByVal Item As String, Optional ByVal Key As String)
  94.     ReDim Preserve m_Array(m_Count + 1) As m_Arrays
  95.     m_Count = m_Count + 1
  96.     'save the key and value
  97.     m_Array(m_Count).m_Value = Item
  98.     m_Array(m_Count).m_Key = Key
  99. End Function
  100.  
  101. Private Function RemoveIt(ByVal m_Index As Integer)
  102.     Dim tmpArray() As m_Arrays, counter As Integer
  103.     
  104.     'if there is only one item then
  105.     If m_Count = 1 Then
  106.         m_Count = 0
  107.         ReDim m_Array(0) As m_Arrays
  108.         Exit Function
  109.     End If
  110.     
  111.     'otherwise, do the following steps
  112.     ReDim tmpArray(m_Count - 1) As m_Arrays
  113.     
  114.     'save all the values and keys of the items
  115.     'BEFORE Index to the temp. array
  116.     For counter = 1 To m_Index - 1
  117.         tmpArray(counter).m_Key = m_Array(counter).m_Key
  118.         tmpArray(counter).m_Value = m_Array(counter).m_Value
  119.     Next
  120.     
  121.     'save all the values and keys of the items
  122.     'AFTER Index to the temp. array
  123.     For counter = m_Index + 1 To m_Count
  124.         tmpArray(counter - 1).m_Key = m_Array(counter).m_Key
  125.         tmpArray(counter - 1).m_Value = m_Array(counter).m_Value
  126.     Next
  127.     
  128.     'update the m_Count and Redim the main array
  129.     m_Count = m_Count - 1
  130.     ReDim m_Array(m_Count) As m_Arrays
  131.     
  132.     'read all the temp. array's values to the
  133.     'main array
  134.     For counter = 1 To m_Count
  135.         m_Array(counter).m_Key = tmpArray(counter).m_Key
  136.         m_Array(counter).m_Value = tmpArray(counter).m_Value
  137.     Next
  138.     
  139. End Function
  140.  
  141. Public Function Itemget(Optional ByVal Index As Integer, Optional ByVal Key As String) As String
  142.     Dim counter As Integer
  143.     
  144.     'if the key and index is invalid, exit function
  145.     If Key = "" And Not Between(Index, 0, m_Count + 1) Then Exit Function
  146.     
  147.     'if index is invalid, get item value using
  148.     'the key
  149.     If Not Between(Index, 0, m_Count + 1) Then
  150.         For counter = 1 To m_Count
  151.             'check to see if this is the item that's needed
  152.             If m_Array(counter).m_Key = Key Then
  153.                 Itemget = m_Array(counter).m_Value
  154.                 Exit Function
  155.             End If
  156.         Next
  157.       'else if the index is valid, get the value
  158.       'using the index
  159.       Else
  160.         Itemget = m_Array(Index).m_Value
  161.     End If
  162.  
  163. End Function
  164.  
  165. Public Function Itemset(ByVal sValue As String, Optional ByVal Index As Integer, Optional ByVal Key As String)
  166.     Dim counter As Integer
  167.     
  168.     'if the key and index is invalid, exit function
  169.     If Key = "" And Not Between(Index, 0, m_Count + 1) Then Exit Function
  170.     
  171.     'if the index is invalid, set the item value
  172.     'using the key
  173.     If Not Between(Index, 0, m_Count + 1) Then
  174.         For counter = 1 To m_Count
  175.             'check if this is the item which value has to be changed
  176.             If m_Array(counter).m_Key = Key Then
  177.                 m_Array(counter).m_Value = sValue
  178.                 Exit Function
  179.             End If
  180.         Next
  181.       'otherwise if the index is valid, use it
  182.       Else
  183.         m_Array(Index).m_Value = sValue
  184.     End If
  185.  
  186. End Function
  187.  
  188. Public Function MoveUp(Optional ByVal Index As Integer, Optional ByVal Key As String)
  189.     Dim counter As Integer
  190.     'if the key and index is invalid, exit function
  191.     If Key = "" And Not Between(Index, 0, m_Count + 1) Then Exit Function
  192.     
  193.     'if index is invalid, use the key
  194.     If Not Between(Index, 0, m_Count + 1) Then
  195.         For counter = 1 To m_Count
  196.             'check if this is the item to move up
  197.             If m_Array(counter).m_Key = Key Then
  198.                 MoveItUp counter
  199.                 Exit Function
  200.             End If
  201.         Next
  202.      'otherwise, move the item using its index
  203.       Else
  204.         MoveItUp Index
  205.     End If
  206. End Function
  207.  
  208. Private Function MoveItUp(ByVal Index As Integer)
  209.     Dim tmpContain As m_Arrays
  210.     
  211.     'since you cannot move the topmost item further
  212.     'up, the function exits
  213.     'the topmost item's index will be 0
  214.     If Index = 1 Then Exit Function
  215.     
  216.     'store the key and value of the item above the
  217.     'about-to-bo-moved item in a temp. container
  218.     tmpContain.m_Key = m_Array(Index - 1).m_Key
  219.     tmpContain.m_Value = m_Array(Index - 1).m_Value
  220.     
  221.     'store the key and value of the item
  222.     'about-to-be-move item to the item abot the
  223.     'about-to-be-moved item
  224.     m_Array(Index - 1).m_Key = m_Array(Index).m_Key
  225.     m_Array(Index - 1).m_Value = m_Array(Index).m_Value
  226.     
  227.     'restore the temp. key and value to the item that
  228.     'is now below the moved-item
  229.     m_Array(Index).m_Key = tmpContain.m_Key
  230.     m_Array(Index).m_Value = tmpContain.m_Value
  231.     
  232. End Function
  233.  
  234. Public Function MoveDown(Optional ByVal Index As Integer, Optional ByVal Key As String)
  235.     Dim counter As Integer
  236.     'if the key and index is invalid, exit function
  237.     If Key = "" And Not Between(Index, 0, m_Count + 1) Then Exit Function
  238.     
  239.     'if index is invalid, move using key
  240.     If Not Between(Index, 0, m_Count + 1) Then
  241.         For counter = 1 To m_Count
  242.             'check if this is the item that has to be moved
  243.             If m_Array(counter).m_Key = Key Then
  244.                 MoveItDown counter
  245.                 Exit Function
  246.             End If
  247.         Next
  248.       'otherwise, if the index is not invalid, USE IT
  249.       Else
  250.         MoveItDown Index
  251.     End If
  252. End Function
  253.  
  254. Private Function MoveItDown(ByVal Index As Integer)
  255.     Dim tmpContain As m_Arrays
  256.     
  257.     'since you cannot move the bottommost item further
  258.     'down, the function exits
  259.